home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 27 / CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso / CUCD / Programming / JForth / JTools / Demos / demo_boxes < prev    next >
Encoding:
Text File  |  1991-12-30  |  1.9 KB  |  77 lines
  1. \ Demonstrate simple graphics operations using JForth.
  2. \ This demo is similar to the BOXES demo from Commodore.
  3. \
  4. \ Author: Phil Burk
  5. \ Copyright 1986  Delta Research
  6. \
  7. \ MOD: PLB 1/16/87 INCLUDE?s added.
  8.  
  9. INCLUDE? NewWindow.Setup JU:AMIGA_GRAPH
  10. INCLUDE? ?CLOSEBOX   JU:AMIGA_EVENTS
  11. INCLUDE? CHOOSE JU:RANDOM
  12.  
  13. ANEW TASK-DEMO_BOXES
  14.  
  15. : RANDOM.BOX  ( w h -- , draw random box in bounds , in current color)
  16.     dup choose swap choose   ( -- w y y , Generate two random Y values )
  17.     2sort >r  ( -- w y1 , push highest Y value )
  18.     swap dup choose swap choose  ( -- y1 x x )
  19.     2sort >r swap r> r>    ( -- x1 y1 x2 y2 )
  20.     gr.rect  ( Draw filled rectangle. )
  21. ;
  22.  
  23. VARIABLE #BOXES/100
  24. : RANDOM.BOXES ( flag -- , draw boxes in multiple colors )
  25.     BEGIN
  26.         100 0 DO
  27. \ This only works on V1.2 Beta-4 of Amiga-DOS.
  28. \ Other versions do not change color. They always use 3 .
  29.             gr.color@ 1+ 3 and gr.color!  ( Cycle colors. )
  30. \ Stay within bounds of current window.
  31. \ Access window structure. ( In 'C':   gr_currentw->width )
  32.             gr-curwindow @  s@ wd_width
  33.             gr-curwindow @  s@ wd_height
  34.             random.box
  35.         LOOP
  36.         1 #boxes/100 +!
  37. \
  38. \ Occasionally change from Insert Mode <--> XOR Mode.
  39.         dup
  40.         IF 5 choose 2 =
  41.             IF gr.mode@
  42.                 1- 1 xor 1+ gr.mode! ( Toggle drawing mode. )
  43.             THEN
  44.         THEN
  45.         ?closebox
  46.     UNTIL drop
  47.     gr_insert_mode gr.mode! ( Back to normal drawing mode. )
  48. ;
  49.  
  50. NewWindow BoxWindow   ( Create a template for the new window. )
  51.  
  52. : (BOXES) ( flag -- , Perform boxes with XOR or not)
  53.     cr ." BOXES - Hit CLOSE BOX to stop!" cr
  54.     gr.init            ( Initialize graphics system. )
  55.     BoxWindow NewWindow.Setup     ( Set defaults for window )
  56. \ Create window from template and make it the current window.
  57.     BoxWindow  gr.opencurw
  58.     IF  0 #boxes/100 !
  59.         random.boxes
  60.         gr.closecurw
  61.         cr #boxes/100 @ 100 * . ."  boxes drawn!" cr
  62.     ELSE drop
  63.     THEN
  64.     gr.term
  65. ;
  66.  
  67.  
  68. : BOXES  ( -- , Demonstrate boxes )
  69.     false (boxes)
  70. ;
  71.  
  72. : FANCY-BOXES  ( -- , Demonstrate boxes with XOR )
  73.     true  (boxes)
  74. ;
  75.  
  76. cr ." Enter:   BOXES     for demo!" cr
  77.